home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / util / shell / axuucp_0_1.lha / axsh / rexx / @.rexx next >
Encoding:
OS/2 REXX Batch file  |  1995-03-22  |  6.9 KB  |  300 lines
  1. /****** axuucp/at ************************************************************
  2. *
  3. *   NAME
  4. *    @ - Append procedures to a script
  5. *
  6. *   SYNOPSIS
  7. *    rx @.rexx [scriptfile]
  8. *
  9. *   DESCRIPTION
  10. *    This script appends some of the procedures in this script to the given
  11. *    scriptfile.  The given sriptfile should contain exactly one line of
  12. *    the form
  13. *
  14. *        /*@<proc1><proc2>...<procN>*/
  15. *
  16. *    The part above this line will be copied to the new scriptfile,
  17. *    everything below will be ignored.
  18. *    The procedures proc1, proc2, ..., procN will then be looked up in this
  19. *    script (@.rexx) and will get appended after the /*@...*/ line in the
  20. *    new scriptfile.
  21. *
  22. *   AUTHOR
  23. *    Tobias Ferber <tf@ganymed.hall.sub.org>
  24. *
  25. ******************************************************************************
  26. *
  27. */
  28.  
  29. fname    = arg(1)
  30. whoami   = "@.rexx"
  31. tempfile = "T:@." || pragma('Id')
  32. done     = 0
  33.  
  34. if words(fname) < 1 then do
  35.   say "usage: rx @.rexx [scriptfile]"
  36.   say d2c(10) || 'Available procedures in "'whoami'":'
  37.   call open('fp',whoami,'Read'); do until eof('fp')
  38.     str= readln('fp'); if left(str,4)='/*@<' then do
  39.       parse var str '/*@' str '*/'; say '  'str; end
  40.     end
  41.   call close('fp')
  42.   exit
  43.   end
  44.  
  45. /**/
  46.  
  47. if open('in',fname,'Read') then do
  48.   if open('out',tempfile,'Write') then do
  49.  
  50.   say 'processing "'fname'"'
  51.  
  52.     do until eof('in') || (done=1)
  53.       str = readln('in')
  54.       call writeln('out',str)
  55.  
  56.       if left(str,3) = '/*@' then do
  57.         parse var str '/*@' str '*/'
  58.         do while (words(str) > 0)
  59.           str = strip(str)
  60.           parse var str '<' proc '>' str
  61.           say '  <'proc'>'
  62.  
  63.           if open('fp',whoami,'Read') then do
  64.             do until eof('fp')
  65.               l = readln('fp')
  66.               if l = '/*@<' || proc || '>*/' then pout=1
  67.               else do
  68.                 if left(l,3)='/*@' then pout=0
  69.                 else if pout=1 then call writeln('out',l)
  70.                 end
  71.               end
  72.             call close('fp')
  73.             end
  74.           else do
  75.             say 'Could not read "'whoami'"'
  76.             end
  77.  
  78.           end
  79.           done=1
  80.         end
  81.       end
  82.  
  83.     call close('out')
  84.     end
  85.  
  86.   else do
  87.     say 'Could not write "'tempfile'"'
  88.     end
  89.  
  90.   call close('in')
  91.   end
  92.  
  93. else do
  94.   say 'Could not read "'fname'"'
  95.   end
  96.  
  97.  
  98. if done=1 then do
  99.   if exists(fname'_') then address command 'Delete QUIET FILE "'fname'_"'
  100.   address command 'Rename QUIET FROM "'fname'" TO "'fname'_"'
  101.   address command 'Copy QUIET FROM "'tempfile'" TO "'fname'"'
  102.   end
  103.  
  104. if exists(tempfile) then address command 'Delete QUIET FILE "'tempfile'"'
  105. exit
  106.  
  107.  
  108. /**/
  109.  
  110.  
  111. /*@<genseq>*/
  112.  
  113. /* from `mbox2ums.rexx' by Tobias Walter */
  114.  
  115. genseq: procedure
  116.   parse arg seqfile
  117.  
  118.   call open('seq',seqfile,'Read')
  119.   seq= readln('seq')
  120.   call close('seq')
  121.  
  122.   if seq>1679616 then seq=1  /* 1679616 = 36*36*36*36 */
  123.  
  124.   call open('seq',seqfile,'Write')
  125.   call writeln('seq',seq+1)
  126.   call close('seq')
  127.  
  128.   uuseq= ""
  129.   do i=0 to 3
  130.     c= seq//36; seq= seq%36    /* 36 = [0-9]+[a-z] */
  131.     if c>=10 then c= d2c(c+87) /* 87 = c2d('a')-10 */
  132.     uuseq= c || uuseq
  133.     end
  134.  
  135.   return uuseq
  136.  
  137. /*@<axconfig>*/
  138.  
  139. /* get an AXsh configuration value */
  140.  
  141. axconfig: procedure
  142.   tempfile = "T:axconfig." || pragma('Id')
  143.   rc_index  = "AXsh:rexx/rc.index"
  144.   var_val=""; var_file=""; var_defval="";
  145.  
  146.   parse upper arg var_name
  147.   if left(var_name,1) ~= '%' then var_name = '%'var_name
  148.   if right(var_name,1) ~= ':' then var_name = var_name':'
  149.  
  150.   if open('idx',rc_index,'Read') then do
  151.     do until (eof('idx') | (var_file~=''))
  152.       str= translate(readln('idx'),' ',d2c(9))
  153.       if words(str) > 0 then do
  154.         parse var str vname ' ' fname '"' defval '"'
  155.         if upper(vname) = var_name then do
  156.           var_file= strip(fname,'B',' 'd2c(9))
  157.           var_defval= defval
  158.           end
  159.         end
  160.       end
  161.     call close('idx')
  162.     end
  163.   else say 'Could not read "'rc_index'"'
  164.  
  165.   if words(var_file) > 0 then do
  166.     if open('rc',var_file,'Read') then do
  167.       do until (eof('rc') | (var_val~=''))
  168.         str= translate(readln('rc'),' ',d2c(9))
  169.         if upper(word(str,1)) = var_name then var_val = strip(readln('rc'),'B',' 'd2c(9))
  170.         end
  171.       call close('rc')
  172.       end
  173.     else say 'Could not examine "'var_file'" for' var_name
  174.     end
  175.   else do
  176.     if words(var_defval) > 0 then var_val= var_defval
  177.     else say 'No such config variable:' var_name
  178.     end
  179.  
  180.   return var_val
  181.  
  182. /*@<rfcaddr>*/
  183.  
  184. /* expects an unfolded RFC 822 header line body, returns the address string or "" */
  185.  
  186. RFCaddr: procedure expose aka
  187.   parse arg str
  188.   str= translate(str,' ',d2c(9))
  189.   if pos('<',str) > 0 then do
  190.     parse var str . "<" str ">"
  191.     if pos(':',str) > 0 then parse var str . ':' str
  192.     end
  193.   else str= word(str,1)
  194.   if pos('@',str) < 1 then str= str'@'aka
  195.   return str
  196.  
  197.  
  198. /*@<strfmt>*/
  199.  
  200. /* substitute all occurences of 'fmt' in 'str' by 'val' */
  201.  
  202. strfmt: procedure
  203.   parse arg str,fmt,val
  204.   p= pos(fmt,str)
  205.   do while p>0
  206.     str= left(str,p-1) || val || substr(str,p+length(fmt))
  207.     p= pos(fmt,str)
  208.     end
  209.   return str
  210.  
  211.  
  212. /*@<transquote>*/
  213.  
  214. /* translate '"' into '*"' and '*' into '**' */
  215.  
  216. transquote: procedure
  217.   parse arg s
  218.   t= s
  219.   q= max( lastpos('*',s), lastpos('"',s) )
  220.   do while q > 0
  221.     t= insert('*',t,q-1,1)
  222.     s= left(s,q-1)
  223.     q= max( lastpos('*',s), lastpos('"',s) )
  224.     end
  225.   return '"' || t || '"'
  226.  
  227.  
  228. /*@<pathonly>*/
  229.  
  230. /* return the non-file part of a pathname */
  231.  
  232. pathonly: procedure
  233.   parse arg path
  234.   if (words(path) > 0) & (right(path,1) ~= ':') then do
  235.     if right(path,1) = '/' then path= left(path,length(path)-1)
  236.     if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
  237.                                              else path= left(path,lastpos(':',path))
  238.     end
  239.   return path
  240.  
  241.  
  242. /*@<fileonly>*/
  243.  
  244. /* return the file part of a pathname */
  245.  
  246. fileonly: procedure
  247.   parse arg path
  248.   if right(path,1) = '/' then path= left(path,length(path)-1)
  249.   p= max( lastpos(':',path), lastpos('/',path) )
  250.   if(p>0) then return substr(path,p+1)
  251.           else return path
  252.  
  253.  
  254. /*@<tackon>*/
  255.  
  256. /* concatenate the filename to the pathname and return the resulting string */
  257.  
  258. tackon: procedure
  259.   parse arg path,file
  260.   do while left(file,1) = '/'
  261.     file= substr(file,2)
  262.     path= pathonly(path)
  263.     end
  264.   if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  265.   if (right(file,1) = '/') then file= left(file,length(file)-1)
  266.   return path || file
  267.  
  268.  
  269. /*@<makepath>*/
  270.  
  271. /* create all non-existant directories in a path */
  272.  
  273. makepath: procedure
  274.   parse arg path
  275.   if right(path,1) = '/' then path= left(path,length(path)-1)
  276.   if ~exists(path) then do
  277.     call makepath( pathonly(path) )
  278.     address command 'MakeDir NAME "'path'"'
  279.     end
  280.   return 0
  281.  
  282. /*@<canexist>*/
  283.  
  284. /*
  285.  * return   1  if the device or volume name in given pathname exists
  286.  *             or if no device or volume was present (current device)
  287.  *          0  if the device or volume name does not exist
  288.  */
  289.  
  290. canexist: procedure
  291.   parse upper arg path
  292.   if pos(':',path) < 1 then return 1 /* current device */
  293.   call pragma('W','N')
  294.   return exists( left(path,lastpos(':',path)) )
  295.  
  296.  
  297. /*@<eof>*/
  298.  
  299. /*EOF*/
  300.